home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
qbscr15.zip
/
DEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1989-09-01
|
45KB
|
1,248 lines
'┌─────────────────────────────────────────────────────────────────────────┐
'│ │
'│ D E M O . B A S │
'│ │
'│ ░▒▓█ A Demonstration Program █▓▒░ │
'│ │
'│ making known the capabilities of │
'│ the QBSCR Screen Routines │
'│ │
'├─────────────────────────────────────────────────────────────────────────┤
'│ │
'│ The QBSCR Screen Routines and this DEMO program are (C) Copyright 1989 │
'│ by Tony Martin of the BAD SOFTWARE Company. │
'│ │
'├─────────────────────────────────────────────────────────────────────────┤
'│ │
'│ Author : Tony Martin │
'│ Date : September 1, 1989 │
'│ Language: Microsoft QuickBASIC 4.0+ │
'│ │
'└─────────────────────────────────────────────────────────────────────────┘
'----------------------------------------------------------------------------
' CONSTants
'----------------------------------------------------------------------------
' Color constants
CONST BLACK = 0
CONST BLUE = 1
CONST GREEN = 2
CONST CYAN = 3
CONST RED = 4
CONST MAGENTA = 5
CONST BROWN = 6
CONST WHITE = 7
CONST BRIGHT = 8
CONST YELLOW = BRIGHT + BROWN
CONST BLINK = 16
' General constants
CONST FALSE = 0, TRUE = NOT FALSE
CONST maxEntries = 13
'----------------------------------------------------------------------------
' SHARED variables (keep these to an absolute minimum)
'----------------------------------------------------------------------------
COMMON SHARED kolor%
'----------------------------------------------------------------------------
' DECLARE statements for the QBSCR Screen Routines
'----------------------------------------------------------------------------
DECLARE FUNCTION BlockSize% (l%, r%, t%, b%)
DECLARE FUNCTION ColorChk ()
DECLARE FUNCTION GetBackground% (row%, col%)
DECLARE FUNCTION GetForeground% (row%, col%)
DECLARE FUNCTION GetString$ (leftCol!, row%, strLen%, foreColor%, backColor%)
DECLARE FUNCTION GetVideoSegment! ()
DECLARE FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
DECLARE FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
DECLARE FUNCTION ScreenBlank$ (delay)
DECLARE SUB Banner (st$, row%)
DECLARE SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!)
DECLARE SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!)
DECLARE SUB BuildScreen (file$, mode%)
DECLARE SUB Center (st$, row%)
DECLARE SUB ClrScr (mode%, fillChar$)
DECLARE SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%)
DECLARE SUB GetScreen (file$)
DECLARE SUB PutScreen (file$)
DECLARE SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$)
DECLARE SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%)
DECLARE SUB OffCenter (st$, row%, leftCol%, rightCol%)
DECLARE SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment)
DECLARE SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment)
DECLARE SUB Wipe (top%, bottom%, lft%, rght%, back%)
'----------------------------------------------------------------------------
' DECLARE statements for routines local to this program
'----------------------------------------------------------------------------
DECLARE FUNCTION Pause% (delay!)
DECLARE SUB BannerDemo ()
DECLARE SUB BlockDemo ()
DECLARE SUB BuildScreenDemo ()
DECLARE SUB CenterOffCenterDemo ()
DECLARE SUB ClosingScreen ()
DECLARE SUB ClrScrDemo ()
DECLARE SUB GetFgBgDemo ()
DECLARE SUB GetPutScreenInfo ()
DECLARE SUB Initialize ()
DECLARE SUB KeyPause ()
DECLARE SUB MenuScreen ()
DECLARE SUB MakeMenuInfo ()
DECLARE SUB MakeWindowDemo ()
DECLARE SUB MovingMessage ()
DECLARE SUB MultiMenuDemo ()
DECLARE SUB OpenScreen ()
DECLARE SUB PointerBox (row%, col%)
DECLARE SUB ScreenBlankDemo ()
DECLARE SUB ScreenInfo ()
DECLARE SUB WipeDemo ()
'----------------------------------------------------------------------------
' The whole of the module-level program...
'----------------------------------------------------------------------------
Initialize
OpenScreen
MenuScreen
ClosingScreen
'----------------------------------------------------------------------------
' The END
'----------------------------------------------------------------------------
SUB BannerDemo
' Set the colors for "Quit" at the bottom of the screen. Make it blink.
IF kolor% THEN
COLOR BLINK + BRIGHT + RED, BLACK
ELSE
COLOR BLINK + BRIGHT + WHITE, BLACK
END IF
Center "Quit ∙ ESC", 21
' Set colors for the banner itself
IF kolor% THEN
COLOR BRIGHT + RED, BLACK
ELSE
COLOR BRIGHT + WHITE, BLACK
END IF
st$ = " The QBSCR Screen Routines Demonstration! "
k$ = ""
' Let the banner scroll until the user hits a key
done% = FALSE
DO
k$ = INKEY$
IF k$ <> "" THEN
done% = TRUE
ELSE
Banner st$, 3
END IF
LOOP UNTIL done%
END SUB
SUB BlockDemo
' Define colors for this demo
IF kolor% THEN
infoFG% = BRIGHT + CYAN: infoBG% = RED
blockFG% = RED: blockBG% = CYAN
ELSE
infoFG% = BLACK: infoBG% = WHITE
blockFG% = BLACK: blockBG% = WHITE
END IF
' Make the window explaining what's going on
MakeWindow 7, 36, 22, 75, infoFG%, infoBG%, 0, 1, 16, 1, " Block Save/Restore "
OffCenter "Using the Block Save and Restore", 9, 35, 75
OffCenter "routines is easy. Simply Save a", 10, 35, 75
OffCenter "portion of the screen with Block", 11, 35, 75
OffCenter "Save, write overtop of that area", 12, 35, 75
OffCenter "and then restore the area with", 13, 35, 75
OffCenter "the Block Restore routine.", 14, 35, 75
OffCenter "In the example at the left, this", 16, 35, 75
OffCenter "is being done repeatedly to", 17, 35, 75
OffCenter "achieve the movement effect.", 18, 35, 75
OffCenter "Hit any key when you are done.", 20, 35, 75
' DIMensions a couple arrays to save screen information
DIM blockArray%(BlockSize%(10, 25, 15, 19))
DIM winArray%(BlockSize%(10, 25, 15, 19))
' Perform initial save of screen block
l% = 10: r% = 25: t% = 15: b% = 19
BlockSave l%, r%, t%, b%, blockArray%(), GetVideoSegment
' Make the window to move
MakeWindow 15, 10, 19, 25, blockFG%, blockBG%, 0, 1, -1, 0, ""
OffCenter "A", 16, 10, 25
OffCenter "Moving", 17, 10, 25
OffCenter "Window", 18, 10, 25
BlockSave l%, r%, t%, b%, winArray%(), GetVideoSegment
' Sit in a loop performing the animation until user hits a key
done% = FALSE
stage% = 0 ' Stage = 0 : window moves up
' Stage = 1 : window moves right
' Stage = 2 : window moves down and left
intraDelay = 100
DO
SELECT CASE stage%
CASE 0 ' window moves up
FOR x% = 14 TO 5 STEP